home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hardcore Visual Basic 5.0 (2nd Edition)
/
Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso
/
Code
/
drivewlk.cls
< prev
next >
Wrap
Text File
|
1997-06-14
|
2KB
|
94 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CDriveWalker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' Implement Basic-friendly version of IEnumVARIANT
Implements IVariantWalker
' Delegate to class that implements real IEnumVARIANT
Private vars As CEnumVariant
' Connect back to parent collection
Private connect As CDrives
Public Enum EErrorDriveWalker
eeBaseDriveWalker = 13040 ' CDriveWalker
End Enum
' Private state data
Private i As Long
Private Sub Class_Initialize()
' Initialize position in collection
i = 1
' Connect walker to CEnumVariant so it can call methods
Set vars = New CEnumVariant
vars.Attach Me
End Sub
' Receive connection from CDrives
Sub Attach(connectA As CDrives)
Set connect = connectA
End Sub
' Return IEnumVARIANT (indirectly) to client collection
Friend Property Get NewEnum() As IEnumVARIANT
Set NewEnum = vars
End Property
' Implement IVariantWalker methods
Private Function IVariantWalker_More(v As Variant) As Boolean
' Find the next drive and return it through reference
Do While i <= 26
' Check flags to see if next drive exists
If MBytes.RShiftDWord(connect.DriveFlags, i - 1) And 1 Then
Dim drive As CDrive
Set drive = New CDrive
drive.Root = i
Set v = drive
IVariantWalker_More = True
i = i + 1
Exit Function
End If
i = i + 1
Loop
End Function
Private Sub IVariantWalker_Skip(c As Long)
' Skip ahead in the iteration
i = i + c
End Sub
Private Sub IVariantWalker_Reset()
' Reset the iteration
i = 1
End Sub
'
#If fComponent = 0 Then
Private Sub ErrRaise(e As Long)
Dim sText As String, sSource As String
If e > 1000 Then
sSource = App.ExeName & ".DriveWalker"
Select Case e
Case eeBaseDriveWalker
BugAssert True
' Case ee...
' Add additional errors
End Select
Err.Raise COMError(e), sSource, sText
Else
' Raise standard Visual Basic error
sSource = App.ExeName & ".VBError"
Err.Raise e, sSource
End If
End Sub
#End If